Analyse - Freie Berufe & Rente

Freie Berufe

Fragestellungen

  • Welcher Inflationsindex passt am besten zu den Daten?
  • Was fällt bei den verschiedenen Indizes auf?
  • Wie können die Unterschiede zwischen den Indizes erklärt werden?
Code
d |>
  filter(name == "Schadensbedarf") |> 
  ggplot(aes(Jahr, `Jährliche Inflation`, group = name)) +
  geom_line() +
  scale_y_continuous(labels = scales::dollar_format()) +
  labs(
    title = "Jährlicher Schadensbedarf"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

Code
d |>
  filter(name != "Schadensbedarf") |> 
  ggplot(aes(Jahr, `Jährliche Inflation`, colour = name, group = name)) +
  geom_line() +
  facet_wrap(vars(name), scales = "free_y", ncol = 1) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "Jährliche Inflation"
    , subtitle = "Veränderungsraten von 2013 bis 2023"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

Code
d_raw |>
  transmute(
    Jahr = factor(Anfalljahr)
    , Schadensbedarf = `Historischer Schadenbedarf`
    , `Index A` = `Jährliche Inflation Index A` +1
    , `Index B` = `Jährliche Inflation Index B` +1
    , `Index C` = `Jährliche Inflation Index C` +1
  ) -> x

tribble(
  ~Jahr, ~Schadensbedarf, ~`Index A`, ~`Index B`, ~`Index C`
  , 2012, 0, 100, 100, 100
) |> mutate(Jahr = factor(Jahr)) |>
  bind_rows(x) |>
  transmute(
    Jahr
    , `Index A` = accumulate(`Index A`, `*`)
    , `Index B` = accumulate(`Index B`, `*`)
    , `Index C` = accumulate(`Index C`, `*`)
  ) |>
  pivot_longer(2:4, names_to = "Index", values_to = "Wert") |>
  ggplot(aes(Jahr, Wert, group = Index, colour = Index)) +
  geom_line() +
  facet_wrap(vars(Index), ncol = 1, scales = "free_y") +
  labs(
    title = "Jährliche Inflation"
    , subtitle = "Indizes von 2013 bis 2023, Basisjahr = 2012"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

  • Indizes B und C haben einen sehr ähnlichen Verlauf (kolinear siehe unten)
  • Die Veränderungsraten von Index B und Index C kovairiieren auf den ersten Blick eher mit der Zeitreiehe des Schadenbedarfs als Index A
  • Als Index mit dem Basisjahr 2012 ergibt sich für Index B eine Steigerung von 22% über den Betrachtungszeitraum, dies deckt sich am ehesten mit der Veränderung von 33,1% in den Schadensbedarfen
  • Die Veränderung in Index A mit etwa 35% stimmt jedoch am ehesten mit der absoluten Zunahme in den Schadensbedarfen am Ende des Betrachtungszeitraums überein
Code
library(fpp3)

d_raw |> 
  rename(
    Schadensbedarf = `Historischer Schadenbedarf`
    , `Index A` = `Jährliche Inflation Index A`
    , `Index B` = `Jährliche Inflation Index B`
    , `Index C` = `Jährliche Inflation Index C`
  ) |> 
  GGally::ggpairs(2:5)

  • Indizes B und C sind perfekt kolinear
  • Paarweise Vergleiche zeigen hohe bivariate Korrelationen von Index B/C mit den jährlichen Schadensbedarfen
  • Index A korreliert negativ mit den Schadensbedarfen
  • Zur Abschätzung der marginalen Effekte wird eine einfache Multivariate Regression für Zeitreihen gerechnet (Einschränkungen durch geringe Stichprobengröße bei Interpretation berücksichtigen)
  • Schadensbedarfe haben scheinbar einen leichten positiven Trend, daher wird auch ein Modell mit einem trend() getestet
Code
fit_schaden <- d_raw |> 
  tsibble(index = Anfalljahr) |> 
  model(
    TSLM_AB = TSLM(`Historischer Schadenbedarf` ~  `Jährliche Inflation Index A` + `Jährliche Inflation Index B`)
    , TSLM_AB_Trend = TSLM(`Historischer Schadenbedarf` ~ trend() + `Jährliche Inflation Index A` + `Jährliche Inflation Index B`)
    , TSLM_B_Trend = TSLM(`Historischer Schadenbedarf` ~ trend() + `Jährliche Inflation Index B`)
    , TSLM_B = TSLM(`Historischer Schadenbedarf` ~ `Jährliche Inflation Index B`)
    )

glance(fit_schaden) |> 
  transmute(Model = .model, adj_r_squared, CV, AIC, AICc, BIC) |> 
  knitr::kable()
Model adj_r_squared CV AIC AICc BIC
TSLM_AB 0.2928033 3656.398 81.12025 87.78692 82.71183
TSLM_AB_Trend 0.4242795 3119.866 79.38886 91.38886 81.37833
TSLM_B_Trend 0.3764999 1103.674 79.73469 86.40136 81.32628
TSLM_B 0.2975563 1225.040 80.34169 83.77026 81.53537
Code
fit_schaden_final <- d_raw |> 
  tsibble(index = Anfalljahr) |> 
  model(
    tslm = TSLM(`Historischer Schadenbedarf` ~ `Jährliche Inflation Index B`)
    )
report(fit_schaden_final)
Series: Historischer Schadenbedarf 
Model: TSLM 

Residuals:
    Min      1Q  Median      3Q     Max 
-47.393 -17.216   1.905  15.488  61.180 

Coefficients:
                              Estimate Std. Error t value Pr(>|t|)   
(Intercept)                     114.33      26.09   4.382  0.00177 **
`Jährliche Inflation Index B`  2999.13    1310.68   2.288  0.04791 * 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 32.44 on 9 degrees of freedom
Multiple R-squared: 0.3678, Adjusted R-squared: 0.2976
F-statistic: 5.236 on 1 and 9 DF, p-value: 0.047913
Code
gg_tsresiduals(fit_schaden_final)

  • Gesamtheitliche Betrachtung der Informationskriterien zeigt, dass ein Modell nur mit Index B zu bevorzugen ist, auch wenn R2 dadurch nicht maximiert wird
  • Ein Trend verbessert die Varianzaufklärung, ist jedoch insbesondere unter Berücksichtigung des AICc keine bedeutende Ergänzung für das Modell
  • Vergleiche der Modelle zeigen damit auch keinen zusätzlichen Informationszugewinn durch das Einbeziehen von Index A

Index B bildet insgesamt zwar nicht den gesamten Effekt in der Entwicklung der Schadensbedarfe ab, jedoch wäre er basierend auf den verfügbaren Informationen ein vielversprechender Prädiktor.

TODO: haben wir in Zeitreihe A einen Outlier und wie würde dies die Ergebnisse verändern?

Renten

Fragestellungen

  • Welche zusätzliche Information lassen sich aus den vorhandenen Daten ableiten?
  • Welche Auffälligkeiten oder Zusammenhänge lassen sich im Datensatz finden?

Datensatz

Vorhandene Features

  • Index
  • Höhe der (monatlichen?) Rentenauszahlung
  • Rentenbeginn (Datum 1)
  • Rentenende (Datum 2)
  • Geburtsdatum (Datum 3)
  • Geschlecht (2, 1, NA)
  • Segment
  • Adresse

Neue Features

  • Alle Datumswerte ISO-Konvertiert (Origin = 1899-12-30 UTC)
  • Geburtsjahr
  • Rentendauer (bei vorhandendem Enddatum)
  • Alter bei Rentenbeginn
  • Alter bei Rentenende
  • Alter heute (05.11.2024)
  • Rentenmonate (bis zum 05.11.2024)
  • Adresskomponenten (Straße, Hausnummer, PLZ, Ort)
  • Summe der bisher ausgezahlten (monatlichen) Rente

Überblick

  • Einige Extremwerte in der Höhe der Rentenauszahlung (TODO: leaverage?)
  • 499 der 600 Einträge entfallen auf das Segment Unfall
  • Der Rest enfällt auf Kraftfahrthaftpflicht (n = 64) und Heilwesenhaftpflicht (n = 25)
  • Sehr wenige Fälle für Privathaftpflicht (n = 3) und Betriebshaftpflicht (n = 9)
Code
x <- d |>
  filter(Renten_Auszahlung < 30000
         , !is.na(Geschlecht)
         , Segment %in% c("Unfall", "Kraftfahrthaftpflicht", "Heilwesenhaftpflicht")
         , ) |>
  select("Renten_Auszahlung", "Geschlecht", "Segment", "Geburtsjahr", "Rente_Beginn_Alter") #


GGally::ggpairs(x, mapping = aes(colour = Segment, alpha = 0.5))

Geschlecht

  • Kein Schlüssel für Zuordnung vorgegeben, Kodierung nach ISO/IEC 5218 angenommen
  • Beide Ausprägungen etwa gleich häufig vorhanden
  • Fünf fehlende Werte
  • Keine großen Effekte zwischen den Geschlechtern (geringer als erwartet)

TODO: GGally nach Geschlecht

Code
d |> 
  filter(Segment == "Unfall") |> 
  summarise(mean= mean(Renten_Auszahlung), median = median(Renten_Auszahlung), n = n(), .by = Geschlecht)
# A tibble: 3 × 4
  Geschlecht  mean median     n
  <fct>      <dbl>  <dbl> <int>
1 Weiblich   2822.  1602.   246
2 Männlich   2591.  1443.   250
3 <NA>       1064.  1034.     3

Ort

  • 1:1 Beziehung zwischen Ort und PLZ
  • 16 Orte/PLZ
  • Sehr viele Fälle aus Berlin, Hannover, Hamburg und München (zusammen n = 417)
  • Kein erkennbares Muster in Strßenverteilung
Code
library(ggridges)
d |>
  ggplot(aes(x = Renten_Auszahlung, Ort, fill = Ort)) +
  geom_density_ridges(alpha = 0.3) +
  geom_point(position = "jitter", alpha = 0.2, aes(color = Ort)) +
  theme_ridges() +
  theme(legend.position = "none") +
  labs(x = NULL, y = NULL, title = "Verteilung der Rentenauszahlungen pro Stadt")
d |>
  count(Strasse, sort = T) |>
  ggplot(aes(x = n, y = Strasse)) +
  geom_point() +
  lims(x = c(0, 40))+
  labs(x = NULL, y = NULL, title = "Häufigkeit der Straßennamen")

Verteilung Rentenauszahlung

  • Verteilung der Renten sind log-normal
Code
d |>
  transmute(
    Renten_Auszahlung
    , Renten_Auszahlung_log = log(Renten_Auszahlung)
  ) |>
  ggplot(aes(Renten_Auszahlung_log)) +
  geom_histogram(bins = 45, fill = "darkgreen", color = "lightgray")

Kummulierte Rentenauszahlungen

  • Keine Sterbeinformation
  • Hinterlegte Rentenenddaten liegen fast ausschließlich in der Zukunft
  • Korrektur für Inflation (Daten für Verbraucherpreisindex nur bis 1992)
  • Annahmen
    • Jährliche Anpassung der Renten (alleinig) basierend auf Verbraucherpreisindex
    • Rentenauszahlung erfolgt monatlich
    • Auszahlungen in €
  • Seit 1992 wurden etwa 432 Mio. € ausgezahlt (477 Mio. € ohne Anpassung)
Code
# Korrektur für Inflation?
Rentenzahlungen_ts <- d |>
  filter(year(Rente_Beginn_Datum) > 1991) |>
  transmute(
    Renten_Auszahlung, Rente_Beginn_Datum = yearmonth(Rente_Beginn_Datum)
    , Datum_Zwischenstand = yearmonth("2024-11-05")
  ) |>
  rownames_to_column("id") |>
  pivot_longer(cols = c(Rente_Beginn_Datum, Datum_Zwischenstand)) |>
  as_tsibble(index = value, key = id) |>
  tsibble::fill_gaps() |>
  tidyr::fill(Renten_Auszahlung, .direction = "down") |>
  select(-name)

CPI <- readxl::read_excel("../data/verbraucherpreisindex-lange-reihen-xlsx-5611103.xlsx"
                   , sheet = "CPI")
Inflation <- CPI |>
  mutate(
    Jahr = parse_number(Jahr)
    , Index = Index / 100
  )

Rentenzahlungen_ts |>
  as_tibble() |>
  mutate(Jahr = year(value)) |>
  left_join(Inflation, by = "Jahr") |>
  tidyr::replace_na(
    list(Index = 1) # keine Daten für 2023, 2024
  ) |>
  transmute(
    value #, id
    , Renten_Auszahlung
    , Renten_Auszahlung_ib = Renten_Auszahlung * Index
  ) |>
  group_by(value) |>
  dplyr::summarise(Renten_Auszahlung = sum(Renten_Auszahlung)
            , Renten_Auszahlung_ib = sum(Renten_Auszahlung_ib)
             ) |>
  ggplot(aes(value)) +
  geom_line(aes(y = Renten_Auszahlung), colour = "darkgreen") +
  geom_line(aes(y = Renten_Auszahlung_ib, colour = "darkred")) +
  theme(legend.position = "none") +
  scale_y_continuous(labels = scales::dollar_format(prefix = "€")) +
  labs(x = NULL, y = NULL,
       title = "Monatliche Rentenauszahlungen"
       , subtitle = "Inflationsanpassung in Rot")

Rentenbeginn

  • Große Unterschiede zwischen den Segmenten
  • Keine eindeutige Saisonalität (Monat/Quartal)
  • Unfall 2011: Änderungen in der gesetzlichen Altersrente
  • Zeitliche Häufung ggf. auf unterschiedliche Produkte zurückführbar (z.B. Heilwesen: hier hat HDI deutlich längere Erfahrung)
Code
pl1 <- d |>
  select(Rente_Beginn_Datum, Segment) |>
  transmute(
    ym = year(Rente_Beginn_Datum)
    , Segment
  ) |>
  count(ym, Segment) |>
  tsibble(index = ym, key = Segment) |>
  autoplot() |> 
  plotly::ggplotly()

pl1

Rentenbeginn und Alter

  • Unterschiedlichen Verteilungen pro Segment
  • Drei Fälle, bei denen der Rentenbeginn z.T. mehrere Jahre vor der Geburt liegt
  • Unfallrente beginnt hier häufig erst (vermeintlich) mit der gesetzlichen Altersrente, jedoch zunehmend im höheren Alter
  • Rentenbeginn für die Haftpflicht-Segmente liegt fast ausnahmslos unterhalb des gesetzlichen Rentenalters
  • Betriebs- und Privathaftpflicht nicht interpretierbar
Code
pl2 <- d |>
  ggplot(aes(Rente_Beginn_Datum, Rente_Beginn_Alter, colour = Segment)) +
  geom_point() +
  geom_abline(slope = 0, intercept = 0, colour = "lightgray") 


pl2 <-   plotly::ggplotly(pl2)

pl2

Rentenende

  • Enddatum für die Rente ist nur in 33 Fällen hinterlegt
  • Fast ausschließlich für Kraftfahrthaftpflicht (n = 24) und nie im Segment Unfall
  • Alter zum hinterlegten End-Zeitpunkt ist für KF- und Privat- Haftpflicht zum Zeitpunkt des vermeitlichen Beginns der gesetzlichen Altersrente
  • Alter zum Rentenenddatum bei der Heilwesenhaftpflicht deutlich niedriger (regelmäßige Überprüfung?)
Code
d |>
  ggplot(aes(Rente_Ende_Alter)) +
  geom_histogram(bins = 20, aes(fill = Segment))

Code
# Bei diesen Renten (alle nich-Unfall) - wird die Rente nur bis zum (voraussichtlichen)
# Entrittsdatum der gesetzlichen Altersrente gezahlt, da es sich um eine Rente zum Ausgleich
# des Verdienstausfalls handelt
# Frage: was ist bei den Haftpflicht-Renten anders, welche kein Enddatum hinterlegt haben?
#     --> haben sich ggf. schon in Rente befunden?
#
# KF-Haftpflicht: alle in der gleichen PLZ, allerdings untersch. Straßen

Alter

  • Errechnetes heutiges Alter (05.11.2024)
  • Sehr große Anzahl an Personen über 90 und über 100 Jahre (Markierung)
  • Fehlen ggf. Sterbedaten
Code
d |> ggplot(aes(Alter_heute)) +
  geom_histogram() +
  geom_vline(xintercept = 100)

Ausreißer

  • Für vertiefte zukünftige Analysen
  • Fünf Einträge ohne Geschlecht
  • Sehr hohe Rentenauszahlungen
  • Sehr alte Personen (Sterbedaten verfügbar?)

Fragen

  • Gibt es Haftpflichtrenten, bei denen das Enddatum fehlt und die schon vom Alter über die Rentengrenze sind? Was ist bei denen anders?

Footnotes

  1. alle Daten im Excel-Datumsformat angeliefert↩︎

  2. alle Daten im Excel-Datumsformat angeliefert↩︎

  3. alle Daten im Excel-Datumsformat angeliefert↩︎